home *** CD-ROM | disk | FTP | other *** search
/ Speccy ClassiX 1998 / Speccy ClassiX 98.iso / amiga_system / the_aminet / comm / bbs / bbbbs85.lha / rexx / bbsDoors.rexx < prev    next >
OS/2 REXX Batch file  |  1995-02-20  |  9KB  |  419 lines
  1. /* $VER: bbsDoors.rexx 8.5 (20.2.95)
  2. copyright 1993-95 Richard Lee Stockton
  3. FREELY DISTRIBUTABLE
  4. Thanks to Matt English for "Jump.rexx"
  5. */
  6.  
  7. IF ~SHOW('P','QuickSortPort') THEN CALL setup.rexx()
  8. IF ~SHOW('P','QuickSortPort') THEN EXIT 666
  9.  
  10. SIGNAL ON BREAK_C
  11. SIGNAL ON FAILURE
  12. SIGNAL ON SYNTAX
  13.  
  14. OPTIONS FAILAT 999999
  15. CALL TIME('R')
  16.  
  17. ARG maxtime name pw
  18. IF ~DATATYPE(maxtime,'N') THEN maxtime=6000
  19.  
  20. namemask=COMPRESS(XRANGE(),XRANGE('A','Z')' _-')
  21. IF ADDRESS()='BAUD' THEN
  22.   DO
  23.     frombb=1
  24.     CR='0D'x
  25.   END
  26. ELSE
  27.   DO
  28.     frombb=0
  29.     CR=''
  30.   END
  31.  
  32. figarg='s:CONFIG.BBS'
  33. IF ~EXISTS(figarg) THEN figarg='BBS:BBS_TEXT/CONFIG.BBS'
  34. x=OPEN(f,figarg,'R')
  35. IF x=0 THEN
  36.   DO
  37.     SAY 's:CONFIG.BBS and BBS:BBS/CONFIG.BBS are both missing!'CR
  38.     EXIT(20)
  39.   END
  40. lynes.=''
  41. DO i=1 TO 6
  42.   lynes.i=READLN(f)
  43. END
  44. CALL CLOSE(f)
  45. compos=POS('/*',lynes.1)
  46. IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
  47. bbsname=STRIP(lynes.1)
  48. sysop  =WORD(lynes.2,1)
  49. bbspath=WORD(lynes.6,1)
  50. IF ~EXISTS(bbspath) THEN
  51.   DO
  52.     SAY bbspath 'does not exist!'CR
  53.     CALL SETCLIP('BBS_STAT')
  54.     EXIT(20)
  55.   END
  56. testchar=RIGHT(bbspath,1)
  57. IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
  58. IF GETCLIP('BBS_path')='' THEN CALL SETCLIP('BBS_path',bbspath)
  59. CALL PRAGMA('D',bbspath'rexxDoors')
  60. IF ARG()=0 THEN
  61.   DO
  62.     SAY
  63.     SAY '                       bbsDoors.rexx'
  64.     SAY '               Original by Matt English 9-30-92'
  65.     SAY '            Alterations by RLS through 11-25-94'
  66.     SAY
  67.   END
  68. IF name='' THEN
  69.   DO
  70.     SAY
  71.     SAY
  72.     options prompt' Are you 'sysop' ? Y or n > '
  73.     pull answer
  74.     if answer='Y' | answer='' then name=sysop
  75.     else DO
  76.       SAY
  77.       options prompt' Please enter your name > '
  78.       pull name
  79.       name=strip(name)
  80.       name=translate(name,'_',' ')
  81.       if name='' then CALL bye
  82.     END
  83.     SAY
  84.   END
  85. file=bbspath'Users/'name
  86. IF ~EXISTS(file) THEN
  87.   DO
  88.     SAY  CR
  89.     SAY 'I can''t find' name 'on the users list!'CR
  90.     SAY 'You should log on to the BBS before you try this!'CR
  91.     CALL delay(100)
  92.     CALL bye
  93.   END
  94.  
  95. colorflag=0
  96. userfile=bbspath'Users/'name
  97. CALL OPEN(data,userfile,'r')
  98. DO i=1 TO 20
  99.   line=readln(data)
  100.   IF i=5 THEN password=line
  101.   IF i=8 THEN
  102.     IF FIND(line,'COLOR')>0 THEN colorflag=1
  103.   IF i=18 THEN winnings=WORD(line,1)
  104.   IF i=20 THEN level=WORD(line,1)
  105.   END
  106. CALL close(data)
  107. IF ~DATATYPE(winnings,'N') THEN winnings=0
  108.  
  109. def='';bak2='';pen3=''
  110. IF colorflag=0 THEN
  111.   DO
  112.     def='';bak2='';pen3=''
  113.   END
  114.  
  115. IF pw~=password THEN
  116.   DO
  117.     passprompt=' 'pen3'Please Enter Password: '
  118.     DO tries=1 TO 3
  119.       OPTIONS PROMPT passprompt
  120.       PULL newpassword
  121.       SAY ''CR
  122.       IF(password=newpassword) THEN LEAVE tries; /* correct password */
  123.       IF tries=3 THEN
  124.         DO
  125.           SAY CR
  126.           SAY 'Access terminated.'CR
  127.           SAY '*** Bad password ***' newpassword '***'CR
  128.           CALL bye
  129.         END
  130.       passprompt='Incorrect.  Password: '
  131.     END
  132.     SAY CR
  133.     SAY' OK, 'name' here we go....'CR
  134.     SAY CR
  135.   END
  136.  
  137. CALL sortdoors()
  138. temp=1
  139. played=0
  140. DO doorloop=1
  141.   IF temp=0 THEN
  142.     DO
  143.       IF played THEN
  144.         DO
  145.           doors.0=''
  146.           CALL sortdoors()
  147.         END
  148.       SAY CR
  149.       SAY CENTER('- Number of accesses per file -',75)||CR
  150.     END
  151.   CALL showtime()
  152.   SAY pen3||LEFT('-',75,'-')||def||CR
  153.   DO jd=1 TO jdoors.0
  154.     IF temp=0 THEN SAY jdoors.jd.0||CR
  155.     ELSE SAY jdoors.jd||CR
  156.   END
  157.   SAY pen3||LEFT('-',75,'-')||def||CR
  158.   IF temp=0 THEN
  159.     DO
  160.       OPTIONS PROMPT '                                 'pen3'Press RETURN 'def
  161.       PULL junk
  162.       temp=1
  163.       SAY CR
  164.       ITERATE doorloop
  165.     END
  166.   arg='Menu'
  167.   CALL postuser()
  168.   temp=getinput(1 0 pen3'Select Application Number. 0=Stats > 'def)
  169.   IF temp=0 THEN ITERATE doorloop
  170.   IF ~DATATYPE(temp,'N') | temp<1 | temp>doors.0 THEN CALL bye
  171.   arg=doors.temp
  172.   IF GETCLIP('BBS_door')=arg | GETCLIP('BBS_localdoor')=arg THEN
  173.     DO
  174.       SAY 'That door is in use!  Try again in a few minutes...'CR
  175.       ITERATE doorloop
  176.     END
  177.   played=1
  178.   IF frombb THEN CALL SETCLIP('BBS_door',arg)
  179.   ELSE CALL SETCLIP('BBS_localdoor',arg)
  180.   CALL Increment.rexx(bbspath'rexxDoors/'arg)
  181.   savewinnings=0
  182.   testwin=''
  183.   IF frombb THEN
  184.     DO
  185.       CALL send2log(arg 'at' TIME('C'))
  186.       CALL SETCLIP('BBS_winnings')
  187.       timeleft=TRUNC(maxtime-TIME('E'))
  188.       IF UPPER(arg)='ONE_ARMED_BANDIT.REXX' THEN
  189.         IF getinput(1 1 'Play for this sessions time in seconds? (Ny) > ')='Y' THEN
  190.           DO
  191.             savewinnings=winnings
  192.             IF savewinnings=0 THEN savewinnings=1
  193.             winnings=timeleft
  194.             SAY 'Playing for REAL seconds, not wimpy play-dollars!'CR
  195.           END
  196.       CALL postuser()
  197.     END
  198.   ELSE CALL TIME('R')
  199.   comm='CALL' arg'('TRANSLATE(name,'_','-') winnings savewinnings colorflag maxtime-TIME('E')-42')'
  200.   INTERPRET comm
  201.   IF frombb THEN
  202.     DO
  203.       testwin=GETCLIP('BBS_winnings')
  204.       IF DATATYPE(testwin,'N') THEN
  205.         DO
  206.           IF savewinnings>0 THEN
  207.             DO
  208.               IF testwin>7200 THEN
  209.                 DO
  210.                   SAY 'Although you won' TRUNC(testwin/60) 'minutes, the maximum session time is 120 minutes.'CR
  211.                   testwin=7200
  212.                 END
  213.               maxtime=TRUNC(testwin+TIME('E'))
  214.               CALL SETCLIP('BBS_maxtime',maxtime)
  215.               winnings=savewinnings
  216.             END
  217.           ELSE
  218.             DO
  219.               winnings=testwin
  220.               CALL SETCLIP('BBS_winnings',winnings)
  221.             END
  222.         END
  223.       CALL SETCLIP('BBS_door')
  224.     END
  225.   ELSE CALL SETCLIP('BBS_localdoor')
  226. END
  227.  
  228.  
  229. sortdoors:
  230. IF ~DATATYPE(jdoors.0,'W') THEN doors.0=0
  231. IF WORDS(SHOWDIR(bbspath'rexxDoors','F'))~=doors.0 THEN
  232.   DO
  233.     played=0
  234.     jdoors.=''
  235.     doorlist=SHOWDIR(bbspath'rexxDoors','F')
  236.     doors.=''
  237.     doors.0=WORDS(doorlist)
  238.     DO i=1 TO doors.0
  239.       doors.i=WORD(doorlist,i)
  240.     END
  241.     CALL QSORT(1,doors.0,doors)
  242.     jdoors.0=doors.0%3
  243.     IF (doors.0//3)>0 THEN jdoors.0=jdoors.0+1
  244.     DO i=1 TO jdoors.0
  245.       DO j=0 TO 2
  246.         k=i+j*jdoors.0
  247.         IF k<=doors.0 THEN
  248.           DO
  249.             jdoors.i=jdoors.i' 'LEFT(RIGHT(k,3)'.' LEFT(doors.k,LENGTH(doors.k)-5),24)
  250.             dcount=WORD(STATEF(bbspath'rexxDoors/'doors.k),8)
  251.             jdoors.i.0=jdoors.i.0||LEFT(RIGHT(dcount,5) LEFT(doors.k,LENGTH(doors.k)-5),24)' '
  252.           END
  253.       END
  254.     END
  255.   END
  256. RETURN 0
  257.  
  258.  
  259. send2log:
  260. PARSE ARG sendline
  261. IF ~frombb THEN RETURN
  262. logfile=bbspath'Logs/log.'DATE('S')    /* daily logs */
  263. fl='W'
  264. IF EXISTS(logfile) THEN fl='A'
  265. IF ~OPEN('log',logfile,fl) THEN
  266.   DO
  267.     IF ~OPEN('log',logfile,fl) THEN
  268.       DO
  269.         SAY 'failed to open log file'CR
  270.         RETURN
  271.      END
  272.   END
  273. CALL WRITELN('log','bbsDoors:' sendline)
  274. CALL CLOSE('log')
  275. RETURN
  276.  
  277.  
  278. getinput:
  279. PARSE ARG upflag' 'oneflag' 'pline
  280. CALL checkdcd()
  281. OPTIONS PROMPT pline
  282. PARSE PULL inarg
  283. inarg=STRIP(inarg)
  284. IF upflag THEN inarg=UPPER(inarg)
  285. IF oneflag THEN inarg=LEFT(inarg,1)
  286. inarg=cleanstring(0':'inarg)
  287. CALL checktime()
  288. RETURN inarg
  289.  
  290.  
  291. showtime:
  292. IF ~frombb THEN RETURN
  293. mins=TIME('E')%60
  294. secs=TRUNC(TIME('E')//60)+1
  295. IF secs>59 THEN secs=59
  296. IF secs<10 THEN secs='0'secs
  297. line=' Time:  Used' mins':'secs
  298. mins=(maxtime-TIME('E'))%60
  299. secs=TRUNC((maxtime-TIME('E'))//60)
  300. IF secs<10 THEN secs='0'secs
  301. line=line'   Remaining' mins':'secs
  302. SAY def||line||CR
  303.  
  304. checktime:
  305. IF ~frombb THEN RETURN
  306. IF TIME('E')>maxtime THEN EXIT 0
  307. IF TIME('E')>(maxtime-120) THEN SAY '*** Less than 2 minutes left! ***'CR
  308. MSG RIGHT(' ',66-LENGTH(name)) '1B'x'M'||''||''||' 'name' level 'level' '||''
  309. CALL checkdcd()
  310. RETURN
  311.  
  312.  
  313. waiting:
  314. CALL checktime()
  315. IF waitchar='Q' THEN
  316.   DO
  317.     waitchar=''
  318.     RETURN
  319.   END
  320. waitchar=''
  321. IF nonstop=1 THEN RETURN
  322. OPTIONS PROMPT pen3'                          RETURN=Continue 'def
  323. PULL waitchar
  324. CALL checkdcd()
  325. RETURN
  326.  
  327.  
  328. checkdcd:
  329. IF ~frombb THEN RETURN
  330. dcd
  331. IF RC=0 THEN
  332.   DO
  333.     DO dcds=1 TO 3  /* 5 second delay */
  334.       CALL DELAY(50)
  335.       dcd
  336.       IF RC~=0 THEN RETURN
  337.     END
  338.     dcd
  339.     IF RC=0 THEN EXIT
  340.   END
  341. xmsg=GETCLIP('BBS_MESSAGE')
  342. IF xmsg~='' THEN
  343.   DO
  344.     CALL SETCLIP('BBS_MESSAGE')
  345.     SAY CR
  346.     SAY bak2' Message From BBBBS: 'def||CR
  347.     SAY xmsg||CR
  348.     SAY CR
  349.     CALL waiting()
  350.   END
  351. IF POS('G',GETCLIP('BBS_COMMAND'))>0 THEN EXIT
  352. RETURN
  353.  
  354.  
  355. strip_ansi:
  356. PARSE ARG aline 
  357. n=POS('1B'x,aline)
  358. DO WHILE n>0
  359.   DO k=2
  360.     IF DATATYPE(SUBSTR(aline,n+k,1),'M') | (n+k+1)>LENGTH(aline) THEN
  361.       leave k
  362.   END
  363.   aline=DELSTR(aline,n,k+1)
  364.   n=POS('1B'x,aline)
  365. END
  366. RETURN aline
  367.  
  368.  
  369. cleanstring:
  370. PARSE ARG nflag':'cstr
  371. IF nflag=1 THEN
  372.   DO
  373.     cstr=COMPRESS(cstr,"'`")
  374.     cstr=TRANSLATE(cstr,,namemask)
  375.     cstr=SPACE(cstr,1,'_')
  376.     RETURN cstr
  377.   END
  378. bot=XRANGE(,'1F'x)
  379. IF nflag=2 THEN bot=COMPRESS(bot,'1B'x)  /* ESC for ANSI */
  380. ELSE cstr=strip_ansi(cstr)
  381. top=XRANGE('7F'x)
  382. cstr=COMPRESS(cstr,bot||top)
  383. IF nflag=0 THEN cstr=STRIP(cstr)
  384. RETURN cstr
  385.  
  386.  
  387. postuser:
  388. IF ~frombb | ~SHOW('P','BBSPOST') THEN RETURN
  389. ptext=GETCLIP('BBSPOST4')
  390. IF WORDS(ptext)>4 THEN ptext=LEFT(ptext,WORDINDEX(ptext,5)-1)
  391. ptext=STRIP(ptext)
  392. ptext=CENTER(ptext'   Door:' arg,74)
  393. CALL SETCLIP('BBSPOST4',ptext)
  394. ADDRESS BBSPOST 'UPDATE'
  395. RETURN
  396.  
  397.  
  398. bye:
  399. BREAK_C:
  400. IF frombb THEN CALL SETCLIP('BBS_door')
  401. ELSE CALL SETCLIP('BBS_localdoor')
  402. SAY CR
  403. EXIT
  404.  
  405.  
  406. FAILURE:
  407. SYNTAX:
  408. lin.1=''ERRORTEXT(RC)''
  409. lin.2=SIGL-1     SOURCELINE(SIGL-1)
  410. lin.3=SIGL ''SOURCELINE(SIGL)''
  411. lin.4=SIGL+1     SOURCELINE(SIGL+1)
  412. DO er=1 TO 4
  413.   IF level>sysoplevel | ~frombb THEN SAY 'bbsDoors:' lin.er||CR
  414.   IF frombb THEN CALL send2log(lin.er)
  415. END
  416. EXIT
  417.  
  418. /* bbsDoors.rexx */
  419.